;; control-set.scm - (c) rohan drape, 2003-2005

;; Return #t iff `cc' is a legal ordering of <control> values.  The
;; set must be sorted i-rate first.

(define (control-set-legal? cc)
  (let loop ((cc cc) 
	     (prev 0))
    (if (null? cc)
	#t
	(let ((r (control-rate (car cc))))
	  (if (< r prev)
	      #f
	      (loop (cdr cc) r))))))

;; Return the <integer> number of <control> values operating at
;; `rate'.

(define (control-set-count-rate cc rate)
  (fold (lambda (r n) (if (= r rate) (+ n 1) n))
	0
	(map control-rate cc)))

;; Return a <list> of the lag values for all k-rate <control> values
;; at `cc'.

(define (control-set-lag-values cc)
  (filter identity
	  (map (lambda (c)
		 (if (= (control-rate c) 1) 
		     (control-lag c)
		     #f))
	       cc)))

;; Generate the <list> of <ugen> values implied by the <list> of
;; <control> values `cc'.  These are instances of Control and
;; LagControl UGens.  There are either one or two of these, if there
;; is a k-rate control UGen it is either a 'Control' UGen or a
;; 'LagControl' UGen.

(define (control-set-implicit-ugens cc)
  (let ((lag? (find (lambda (e) (> (control-lag e) 0)) cc))
	(all (length cc))
	(ir (control-set-count-rate cc 0))
	(kr (control-set-count-rate cc 1)))
    (cond ((= all 0)
	   '())
	  ((or (= kr 0) (= ir 0))
	   (list (make-ugen (if lag? "LagControl" "Control")
			    (if (= ir 0) 1 0)
			    (if lag? (map (lambda (e) 
					    (make-constant e))
					  (control-set-lag-values cc))
				(list))
			    (map make-output (make-list all (if (= ir 0) 1 0)))
			    0)))
	  (else
	   (list (make-ugen "Control"
			    0
			    (list)
			    (map make-output (make-list ir 0))
			    0)
		 (make-ugen (if lag? "LagControl" "Control")
			    1
			    (if lag? (map (lambda (e) 
					    (make-constant e))
					  (control-set-lag-values cc))
				(list))
			    (map make-output (make-list kr 1))
			    ir))))))

;; Return the <list> of UGen indices for `cc', these are indexes into
;; the implicit UGens.

(define (control-set-ugen-indices cc)
  (map (lambda (c)
	 (if (or (= (control-rate c) 0) (= (control-set-count-rate cc 0) 0))
	     0
	     1))
       cc))

;; Return the <list> of port indices for `cc'.

(define (control-set-port-indices cc)
  (let loop ((i 0)
	     (k 0)
	     (cc cc)
	     (r (list)))
    (if (null? cc)
	(reverse r)
	(let ((rate (control-rate (car cc))))
	  (loop (+ i (if (= rate 0) 1 0))
		(+ k (if (= rate 1) 1 0))
		(cdr cc)
		(cons (if (= rate 0) i k) r))))))

;; Generate implicit UGens and rewrite the <control> values with the
;; appropriate <output-proxy>.

(define (control-set-close cc)
  (if (control-set-legal? cc)
      (let ((uu (control-set-implicit-ugens cc)))
	(map (lambda (c u p)
	       (control/proxy c (make-output-proxy (ref uu u) p)))
	     cc
	     (control-set-ugen-indices cc)
	     (control-set-port-indices cc)))
      (error "control-set-close: illegal control-set" cc)))

;; Given a list of descriptors of the form (label default lag rate)
;; generate a list of <control> values.  The list may be nested if any
;; default values are lists.

(define (make-control-set descriptors)
  (let ((cc (unfoldL (lambda (d i) (null? d))
		     (lambda (d i) (letL (((label default lag rate)
					   (car d)))
				     (make-control/multiple
				      (symbol->string label)
				      i
				      default
				      lag 
				      rate)))
		     (lambda (d i) (letL (((label default lag rate)
					   (car d)))
				     (list (cdr d)
					   (if (list? default)
					       (+ i (length default))
					       (+ i 1)))))
		     (list descriptors 0))))
    (list->tree 
     (control-set-close (tree-leaves cc))
     cc)))

;; Syntax to create <control> values and evaluate `expr' in a context
;; where the control name, called a label below, is bound to a value
;; that may be used as an input to a UGen.  If `lag' is not provided
;; it defaults to 0.  If `rate' is not provided it defaults to 1.  The
;; result of this expression is the result of `expr'.  

(define-syntax with-control-set
  (syntax-rules ()
    ((_ () expr)
     expr)
    ((_ ((label default) ...) expr)
     (with-control-set ((label default 0 1) ...) expr))
    ((_ ((label default lag) ...) expr)
     (with-control-set ((label default lag 1) ...) expr))
    ((_ ((label default lag rate) ...) expr)
     (match (make-control-set (list (list 'label default lag 'rate) ...))
	    ((list label ...)
	     expr)))))
